Temporal by state and indicator

Took Prescription Medication for Mental Health, Last 4 Weeks

Resources for Value-Suppressing Uncertainty Palettes: https://github.com/clauswilke/multiscales

MainStates <- map_data("state") %>% mutate(State = tolower(region)) 
merged_pres <- inner_join(MainStates, data_states_13_meds, by = "State")

region.lab.data <- merged_pres %>%
  group_by(State) %>% summarise(long=mean(long), lat=mean(lat))

# Color for Value-Suppressing Uncertainty Palettes
colors <- scales::colour_ramp(
  colors = c(red = "#AC202F", purple = "#740280", blue = "#2265A3")
)((0:7)/7)

#---- VSUP ggplot

# map_took_pres <- ggplot(merged_pres) +
#   geom_polygon(aes(x=long, y=lat, group=group, fill = zip(Value, CIint), frame =  t), 
#                color="white", size = 0.2) +
#   bivariate_scale("fill",
#                   pal_vsup(values = colors, max_desat = 0.8, pow_desat = 0.2, max_light = 0.7, pow_light = 1),
#                   name = c("Percentage", "uncertainty"),
#                   # limits = list(c(min(merged_pres$Value), max(merged_pres$Value)),
#                                 # c(min(merged_pres$CIint), max(merged_pres$CIint))),
#                   breaks = list(waiver(), c(0, 1)),
#                   # breaks = list(c(10, 15, 20, 25, 30, 35), c(0, 5, 10, 15, 20)),
#                   labels = list(waiver(), scales::percent),
#                   guide = "colourfan") + theme_void()

map_took_pres <- ggplot() + 
  geom_polygon(data=merged_pres, 
          aes(x=long, y=lat, group=group, fill = Value, frame =  t), 
          color="white", size = 0.2) +
  scale_fill_gradient(
    low = "lightblue", high = "darkred",
    name = c("Percentage")) + 
  geom_text(aes(label = State,x = long, y = lat), data = region.lab.data, size=1, alpha = 0.001) +
  theme_classic()+
  theme(axis.line=element_blank(),
      axis.text.x=element_blank(),
      axis.text.y=element_blank(),
      axis.ticks=element_blank(),
      axis.title.x=element_blank(),
      axis.title.y=element_blank())+
  labs(title="Took Prescription Medication for Mental Health, Last 4 Weeks", fill = "%") 

fig <- ggplotly(map_took_pres) 
fig <- fig %>% 
  animation_opts(
    50, easing = "elastic", redraw = FALSE
  ) %>%
  animation_slider(
    currentvalue = list(prefix = "Time Period ", font = list(color="red"))
  ) #%>%
  # layout(annotations = list(x = -120, y = 25, text = paste("Time Period: ",
  #   merged_pres$`Time Period Label`), showarrow = F))
  

fig$x$frames <- lapply(
  fig$x$frames, function(f) { 
    f$data <- lapply(f$data, function(d) d[!names(d) %in% c("x", "y")])
    f 
  })

fig

Received Counseling or Therapy, Last 4 Weeks

Took Prescription Medication for Mental Health And/Or Received Counseling or Therapy, Last 4 Weeks

Needed Counseling or Therapy But Did Not Get It, Last 4 Weeks

Period mismatch

## # A tibble: 16 x 2
##    `Time Period` `Time Period Label`
##            <dbl> <chr>              
##  1            13 Aug 19 - Aug 31    
##  2            14 Sep 2 - Sep 14     
##  3            15 Sep 16 - Sep 28    
##  4            16 Sep 30 - Oct 12    
##  5            17 Oct 14 - Oct 26    
##  6            18 Oct 28 - Nov 9     
##  7            19 Nov 11 - Nov 23    
##  8            20 Nov 25 - Dec 7     
##  9            21 Dec 9 - Dec 21     
## 10             1 Dec 22 - Jan 5     
## 11            22 Jan 6 - Jan 18     
## 12            23 Jan 20 - Feb 1     
## 13            24 Feb 3 - Feb 15     
## 14            25 Feb 17 - Mar 1     
## 15            26 Mar 3 - Mar 15     
## 16            27 Mar 17 - Mar 29

Mar 17 - Mar 29 –> 27 Dec 22 - Jan 5 –> 1 –> between 21 and 22

period numbers mismatch

add national averages

add state label